perm filename X5.FAI[TMP,LCS] blob sn#136258 filedate 1974-12-18 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00010 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	TITLE X
C00003 00003	BEG:	SETOM LINE
C00012 00004	MVLFT:	MOVMS 0
C00018 00005	FNF:	PUSHJ P,DETCHK
C00021 00006	FRD:	MOVSI A,'DMD'
C00023 00007	GETNAM:	MOVEI A,
C00024 00008	XINI:	OUTSTR [ASCIZ /TOTAL LENGTH IN INCHES (Y DIMENSION, DEFAULT = 11)?/]
C00027 00009	XGPOUT:	OPEN XGP,[1017↔'XGP   '↔0]
C00031 00010	FILNAM:	0
C00032 ENDMK
C⊗;
TITLE X
A←1
B←2
C←3
D←4
E←5
L←6
U←7
X←11
Y←12
XD←13
T←15
TT←16
P←17
LPDL←←69
DSK←←1
XGP←←2
LMAR←←=0
RMAR←←=1699
WIDTH←←=1700
LBUFL←←=48
LSTBIT←←1⊗34
OVERLAP←←=50
DOFF←←-=760
NBUFS←←4
EXTERN JOBREL,JOBFF
MAILBF:	BLOCK 40
SIGN:	0
LINE:	0
PNTR:	0
BEG:	SETOM LINE
	GETLIN LINE		;FOR ERROR PRINTOUT
	CALLI
	HRRZS LINE		;CLEAR LINE BITS
	MOVE P,[-LPDL,,PDL-1]
FILIN:	OUTSTR [ASCIZ /FILE? (DEFAULT IS PLT.DMD) /]
	PUSHJ P,FRD
	SETZ A,
YAGN1:	HRREI B,-60
OUTSTR [ASCIZ/ORIGIN X OFFSET FROM SIDE (DEFAULT IS 4(CENTER))?/]
	PUSHJ P,RNUM
	JRST [	HRREI A,-=760 
		JRST YDEF]
	IMULI A,=100
	CAIN C,"."		;DECIMAL POINT?
	JRST [	INCHWL C
		CAIN C,15
		INCHWL C
		CAIL C,"0"
		CAILE C,"9"
		JRST .+1
		SUBI C,60
		IMULI C,=10
		SKIPE SIGN
		MOVN C,C
		ADD A,C
		PUSH P,A
		PUSHJ P,RNUM
		JFCL
		POP P,A
		JRST .+1]
	MOVN A,A
	LSH A,1			;*2 (MAKE IT STEPS)
YDEFP:	CAIE C,12
	JRST [	CLRBFI
		JRST YAGN1]
YDEF:	ADD A,B
	MOVNM A,INIX#
AGAIN:	MOVE A,[FILNAM,,LKENT]
	BLT A,LKENT+3
	OPEN DSK,[14↔'DSK   '↔IBUF]
	JRST 4,.
	INBUF DSK,NBUFS
	LOOKUP DSK,LKENT
	JRST FNF
ASKLEN:	SETZM POOBX#
	SETZM POOBY#
	PUSHJ P,XINI
	JRST CORLUZ
	SETZM XX#
	SETZM YY#
	MOVEI C,3
	HRRZM C,PENN#
OUTER:	IN DSK,
	JRST PLOT
	STATO DSK,20000
	JRST 4,.
	RELEAS DSK,
IFN LSTBIT-1,<PUSHJ P,XFIX>
	JRST XGPOUT

PLOT:	HRR C,IBUF+1
	MOVN E,1(C)
	MOVSI E,(E)
	HRR E,IBUF+1

PLOT1:	MOVE 14,2(E)
	LSHC 14,-10
	ASH 15,-34
	MOVEM 15,SVPEN#
	MOVM A,15
	LSHC 14,-16
	ASH 15,-26
	MOVEM 15,SVY#
	SUB 15,YY
	MOVEM 15,SVYSB#
	IMULI 15,LBUFL+1
	ADD 15,Y
	MOVEM 15,SVYOD#
	CAIGE 15,(L)
	JRST LOSE
	CAIL 15,-LBUFL-1(U)
	JRST LOSE
	LSHC 14,-16
	ASH 15,-26
	MOVEM 15,SVX#
	SUB 15,XX
	MOVE 0,15
	HRRZ 16,X
	IMULI 16,44
	JFFO B,.+1
	ADD 16,C
	SUB 16,15
	JUMPL 16,LOSEX
	CAILE 16,=1727
	JRST LOSEX
	SKIPE OOBFLG#
	JRST OOBAR
	CAIE A,1
	HRRM A,PENN
	HRR A,PENN
	CAIN A,3
	JRST PENUP
	MOVE C,SVYSB
	IORM B,@X
	JUMPE NORMX
	JUMPL MVLFT
	JUMPE C,NRT
	JUMPL C,MVDWN
	CAMLE C,0
	JRST XCHA
	SETZ 14,
	TLNE C,200000
	JRST .+4
	LSH C,1
	TRO C,1
	AOJA 14,.-4
	SUBI 14,=34
	IDIV C,0
	MOVNS 14
	LSH C,(14)
	SETZ 15,
INLOOP:	ADD 15,C
	TLZE 15,200000
	ADDI Y,LBUFL+1
	SKIPGE B
	SOJ X,
	ROT B,1
	IORM B,@X
	SOJG INLOOP
	JRST DONXT

OOBAR:	SETZM OOBFLG
PENUP:	HRR Y,SVYOD
	JUMPE 15,NXTY
	JUMPL 15,PULFT
	CAIGE 15,44
	JRST XLOOP
	IDIVI 15,44
	SUB X,15
	HRR 15,16
XLOOP:	SOJL 15,DONXT
	SKIPGE B
	SOJ X,
	ROT B,1
	JRST XLOOP

PULFT:	MOVMS 15
	CAIGE 15,44
	JRST OOO
	IDIVI 15,44
	ADD X,15
	HRR 15,16
OOO:	SOJL 15,DONXT
	ROT B,-1
	JUMPGE B,OOO
	AOJ X,
	JRST OOO

XCHA:	SETZ 14,
	TLNE 0,200000
	JRST .+4
	LSH 0,1
	TRO 0,1
	AOJA 14,.-4
	SUBI 14,=34
	IDIV 0,C
	MOVNS 14
	LSH 0,(14)
	SETZ 15,
INLOO:	ADD 15,0
	TLZN 15,200000
	JRST MVUP
	SKIPGE B
	SOJ X,
	ROT B,1
MVUP:	ADDI Y,LBUFL+1
	IORM B,@X
	SOJG C,INLOO
	JRST DONXT

MVDWN:	MOVMS C
	CAMLE C,0
	JRST XCHA2
	SETZ 14,
	TLNE C,200000
	JRST .+4
	LSH C,1
	TRO C,1
	AOJA 14,.-4
	SUBI 14,=34
	IDIV C,0
	MOVNS 14
	LSH C,(14)
	SETZ 15,
INLOP:	ADD 15,C
	TLZE 15,200000
	SUBI Y,LBUFL+1
	SKIPGE B
	SOJ X,
	ROT B,1
	IORM B,@X
	SOJG INLOP
	JRST DONXT

XCHA2:	SETZ 14,
	TLNE 0,200000
	JRST .+4
	LSH 0,1
	TRO 0,1
	AOJA 14,.-4
	SUBI 14,=34
	IDIV 0,C
	MOVNS 14
	LSH 0,(14)
	SETZ 15,
INOOP:	ADD 15,0
	TLZN 15,200000
	JRST MVEX
	SKIPGE B
	SOJ X,
	ROT B,1
MVEX:	SUBI Y,LBUFL+1
	IORM B,@X
	SOJG C,INOOP
	JRST DONXT

NRT:	JUMPL B,GOOP
TOOT:	ROT B,1
	IORM B,@X
	SOJG 0,NRT
	JRST DONXT
GOOP:	SOJ X,
	CAIGE 0,44
	JRST TOOT
	IDIVI 0,44
	SETOM @X
	SOJ X,
	SOJG 0,.-2
	HRR 0,1
	JUMPN 0,TOOT
	AOJ X,
	JRST DONXT

NLFT:	MOVMS 0
	ROT B,-1
	JUMPL B,ROOT
WOOP:	IORM B,@X
	SOJG 0,.-3
	JRST DONXT
ROOT:	AOJ X,
	CAIGE 0,44
	JRST WOOP
	IDIVI 0,44
	SETOM @X
	AOJ X,
	SOJG 0,.-2
	HRR 0,1
	JUMPN 0,WOOP
	SOJ X,
	ROT B,1
	JRST DONXT
NORMX:	JUMPE C,NOMOVE
	JUMPL C,MDOWN
MUP:	ADDI Y,LBUFL+1
	IORM B,@X
	SOJG C,MUP
	JRST DONXT
MDOWN:	SUBI Y,LBUFL+1
	IORM B,@X
	AOJL C,MDOWN
DONXT:	MOVE 4,SVX
	MOVEM 4,XX
NXTY:	MOVE 4,SVY
	MOVEM 4,YY
NOMOVE:	SKIPL SVPEN
	JRST ENOUT
	SETZM XX
	SETZM YY
ENOUT:	AOBJN E,PLOT1
	JRST OUTER

MVLFT:	MOVMS 0
	MOVMS 15
	JUMPE C,NLFT
	HRR Y,SVYOD
	IDIVI 15,44
	ADD X,15
XEND:	SOJL 16,DUN
	ROT B,-1
	JUMPGE B,XEND
	AOJ X,
	JRST XEND
DUN:	MOVEM X,XX
	MOVEM B,YY
	IORM B,@X
	JUMPL C,MVLD
	CAMLE C,0
	JRST XCHA3
	SETZ 14,
	TLNE C,200000
	JRST .+4
	LSH C,1
	TRO C,1
	AOJA 14,.-4
	SUBI 14,=34
	IDIV C,0
	MOVNS 14
	LSH C,(14)
	SETZ 15,
ILOOP:	ADD 15,C
	TLZE 15,200000
	SUBI Y,LBUFL+1
	SKIPGE B
	SOJ X,
	ROT B,1
	IORM B,@X
	SOJG ILOOP
	JRST BFOR

XCHA3:	SETZ 14,
	TLNE 0,200000
	JRST .+4
	LSH 0,1
	TRO 0,1
	AOJA 14,.-4
	SUBI 14,=34
	IDIV 0,C
	MOVNS 14
	LSH 0,(14)
	SETZ 15,
ILOP:	ADD 15,0
	TLZN 15,200000
	JRST DOQ
	SKIPGE B
	SOJ X,
	ROT B,1
DOQ:	SUBI Y,LBUFL+1
	IORM B,@X
	SOJG C,ILOP
	JRST BFOR

MVLD:	MOVMS C
	CAMLE C,0
	JRST XCHA4
	SETZ 14,
	TLNE C,200000
	JRST .+4
	LSH C,1
	TRO C,1
	AOJA 14,.-4
	SUBI 14,=34
	IDIV C,0
	MOVNS 14
	LSH C,(14)
	SETZ 15,
LOOP:	ADD 15,C
	TLZE 15,200000
	ADDI Y,LBUFL+1
	SKIPGE B
	SOJ X,
	ROT B,1
	IORM B,@X
	SOJG LOOP
	JRST BFOR

XCHA4:	SETZ 14,
	TLNE 0,200000
	JRST .+4
	LSH 0,1
	TRO 0,1
	AOJA 14,.-4
	SUBI 14,=34
	IDIV 0,C
	MOVNS 14
	LSH 0,(14)
	SETZ 15,
LOP:	ADD 15,0
	TLZN 15,200000
	JRST DOP
	SKIPGE B
	SOJ X,
	ROT B,1
DOP:	ADDI Y,LBUFL+1
	IORM B,@X
	SOJG C,LOP
BFOR:	HRR Y,SVYOD
	MOVE X,XX
	MOVE B,YY
	JRST DONXT

FNF:	PUSHJ P,DETCHK
	PUSHJ P,XERR
	PUSHJ P,ERRPNT
	ASCIZ /LOOKUP FAILED.
/
	SKIPGE DET
	CALLI 12
	JRST FILIN

CORLUZ:	MOVE T,TT
	LSH T,-12
	PUSH P,T
	PUSHJ P,DETCHK
	PUSHJ P,XERR
	POP P,T
	PUSHJ P,DECOUT
	PUSHJ P,ERRPNT
	ASCIZ / K OF CORE NEEDED!
/
	SKIPGE DET
	CALLI 12
	JRST ASKLEN

LOSEX:	SETOM OOBFLG
	SKIPE POOBX
	JRST PENUP
	SETOM POOBX
	PUSHJ P,DETCHK
	PUSHJ P,XERR
	PUSHJ P,ERRPNT
	ASCIZ /POINT OUT OF BOUNDS, /
	JUMPL 16,[PUSHJ P,ERRPNT
		  ASCIZ/-X/
		  JRST PENUP]
	PUSHJ P,ERRPNT
	ASCIZ/+X/
	JRST PENUP

LOSE:	SETOM OOBFLG
	SKIPE POOBY
	JRST LOBAC
	SETOM POOBY
	PUSHJ P,DETCHK
	PUSHJ P,XERR
	PUSHJ P,ERRPNT
	ASCIZ /POINT OUT OF BOUNDS, /
	CAIGE 15,(L)
	JRST [	PUSHJ P,ERRPNT
		ASCIZ/-Y/
		JRST LOBAC]
	PUSHJ P,ERRPNT
	ASCIZ/+Y/
LOBAC:	LSHC 14,-16
	ASH 15,-26
	MOVEM 15,SVX
	SUB 15,XX
	JRST PENUP

DECOUT:	IDIVI T,=10
	HRLM TT,(P)
	SKIPE T
	PUSHJ P,DECOUT
	HLRZ TT,(P)
	ADDI TT,60
	ROT TT,-7
	MOVEM TT,.+2
	PUSHJ P,ERRPNT
	0
	POPJ P,

ERRPNT:	HRRZ TT,(P)
	MOVEM TT,PNTR
	MOVEI TT,LINE
	TTYMES TT,
	JRST [	OUTSTR[ASCIZ/TTYMES FAILED	/]
		OUTSTR @PNTR
		OUTSTR[ASCIZ/
/]
		JRST .+1]
	POP P,TT
	HRL TT,(TT)
	TLNE TT,376
	AOJA TT,.-2
	JRST 1(TT)

XERR:	PUSHJ P,ERRPNT
	ASCIZ/
MESSAGE FROM X WORKING ON /
	MOVE TT,FILNAM
	PUSHJ P,SIXOUT
	PUSHJ P,ERRPNT
	ASCIZ/./
	HLLZ TT,FILEXT
	PUSHJ P,SIXOUT
	PUSHJ P,ERRPNT
	ASCIZ/[/
	MOVE TT,FILPPN
	PUSHJ P,SIXOUT
	PUSHJ P,ERRPNT
	ASCIZ/] : /
	POPJ P,

SIXOUT:	JUMPE TT,CPOPJ
	SETZ T,
	LSHC T,6
	ADDI T,40
	PUSH P,TT
	ROT T,-7
	MOVEM T,.+2
	PUSHJ P,ERRPNT
	0
	POP P,TT
	JRST SIXOUT

DETCHK:	SETOM DET#
	GETLIN DET
	HRRES DET
	SKIPL DET
	AOS (P)
	POPJ P,
FRD:	MOVSI A,'DMD'
	MOVEM A,FILEXT
	PUSHJ P,GETNAM
	SKIPN A
 	MOVE A,['PLT   ']
    	MOVEM A,FILNAM
	CAIE C,"."
	JRST NOEXT
	PUSHJ P,GETNAM
	MOVEM A,FILEXT
NOEXT:	CAIE C,"["
	JRST FRDX
	PUSHJ P,GETP
	HRLZM A,FILPPN
	PUSHJ P,GETP
	HRRM A,FILPPN
FRDX:	INCHRW C
	CAIE C,12
	JRST FRDX
	POPJ P,

RNUM:	INCHWL C
	CAIN C,15
	JRST RNUM
	CAIN C,12
	POPJ P,
	AOS (P)
	MOVEI A,
	SETZM SIGN
	CAIN C,"-"
	JRST [	PUSHJ P,RNUML
		SETOM SIGN
		MOVN A,A
		POPJ P,]
	CAIN C,"+"
RNUML:	INCHWL C
	CAIL C,"0"
	CAILE C,"9"
	JRST RNUMX
	IMULI A,12
	ADDI A,-"0"(C)
	JRST RNUML

RNUMX:	CAIN C,15
	INCHRW C
	POPJ P,
GETNAM:	MOVEI A,
	MOVE B,[440600,,A]
GETNML:	PUSHJ P,RCH
	POPJ P,
	SUBI C,40
	TLNE B,770000
	IDPB C,B
	JRST GETNML

GETP:	MOVEI A,
GETPL:	PUSHJ P,RCH
	POPJ P,
	TRNE A,770000
	JRST GETPL
	LSH A,6
	ADDI A,-40(C)
	JRST GETPL

RCH:	INCHWL C
	CAIN C,42
	JRST RCHQ
	CAIE C,11
	CAIN C," "
	JRST RCH
	CAIE C,"."
	CAIN C,","
	POPJ P,
	CAIE C,"["
	CAIN C,"]"
	POPJ P,
RCHQR:	CAIGE C,40
	POPJ P,
	CAIL C,"a"
	CAILE C,"z"
	CAIA
	SUBI C,40
	JRST POPJ1

RCHQ:	INCHWL C
	JRST RCHQR
XINI:	OUTSTR [ASCIZ /TOTAL LENGTH IN INCHES (Y DIMENSION, DEFAULT = 11)?/]
	PUSHJ P,RNUM
	MOVEI A,=11		;ASSUME 11 INCHES
	JUMPLE A,[XINLER:CLRBFI
		JRST XINI]
	CAIE C,12
	JRST XINLER
	IMULI A,=200
	PUSH P,A
YINI1:	OUTSTR [ASCIZ \ORIGIN Y OFFSET FROM BOTTOM, 200/IN.(DEFAULT IS 100)?\]
	PUSHJ P,RNUM
	JRST [	MOVEI A,=100
		JRST IYDEF]
	CAIE C,12
	JRST [	CLRBFI
		JRST YINI1]
IYDEF:	IMULI A,LBUFL+1
	MOVEM A,IYPOS#
	POP P,A
XDEF:	MOVEM A,LINCNT#
	MOVEI B,-1(A)
	IMULI A,LBUFL+1
	MOVE T,JOBFF
	MOVEM T,XGPPTR
	SOS XGPPTR
	MOVEI T,2(A)
	MOVNI TT,(T)
	ADD T,XGPPTR
	HRLM TT,XGPPTR
	MOVE TT,T
	CALLI T,11
	POPJ P,
	HRRZ L,XGPPTR
	MOVSI T,1(L)
	HRRI T,2(L)
	SETZM 1(L)
	MOVE U,JOBREL
	BLT T,(U)
	MOVE TT,[BYTE (12)4001,LMAR,LBUFL]
	MOVEM TT,1(L)		;FIRST ONE HAS MARK AND CUT WITH IT
	TLZ TT,400000		;DELETE MARK AND CUT
	MOVEI T,1+LBUFL+1(L)
XINL:	MOVEM TT,(T)
	ADDI T,LBUFL+1
	SOJG B,XINL
	MOVSI TT,400100
	MOVEM TT,(T)		;SO DOES LAST
	MOVE Y,IYPOS
	ADDI Y,2(L)
	MOVEI XD,DBUF+1
	SKIPL A,INIX		;WHERE DO WE START
	JRST MAYBON
	SUBI A,43
	IDIV A,[-44]
	HRLOI X,XD
	SOJA A,SETB

MAYBON:	ADDI A,43
	IDIVI A,44
	CAILE A,LBUFL
	JRST OFFRT
	MOVE X,A
	SETZ A,
	HRLI X,Y
	JRST SETB

OFFRT:	MOVE X,[XD,,LBUFL]
	SUBI A,LBUFL
SETB:	MOVE B,INIX
	IDIVI B,44
	MOVSI B,400000
	MOVN C,C
	ROT B,(C)
POPJ1:	AOS (P)
CPOPJ:	POPJ P,
XGPOUT:	OPEN XGP,[1017↔'XGP   '↔0]
	JRST NOXGP
	OUTSTR[ASCIZ/CRANKING XGP
/]
	LOCK
OUTIT:	OUT XGP,XGPPTR
	JRST OUTOK
DSKERR:	PUSHJ P,DETCHK
	PUSHJ P,XERR
	PUSHJ P,ERRPNT
	ASCIZ /XGP OUTPUT ERROR.
/
OUTOK:	UNLOCK
	RELEAS XGP,
XMORE:	PUSHJ P,CORDWN			;REALLY DONE, CORE DOWN
	PUSHJ P,DETCHK
	JRST DODEL			;DELETE AUTOMATICALLY IF DETACHED
	OUTSTR[ASCIZ/DELETE BIN FILE?/]
	INCHRW C
	CAIN C,15
	INCHRW C
	CAIE C,12
	OUTSTR[ASCIZ/
/]
	CAIE C,"Y"
	CAIN C,"y"
	CAIA
	JRST NODEL
DODEL:	MOVE A,[FILNAM,,LKENT]
	BLT A,LKENT+3
	INIT DSK,17
	'DSK   '
	0
	JRST [	SKIPGE DET
		PUSHJ P,XERR
		PUSHJ P,ERRPNT
		ASCIZ/COULDN'T GET DISK FOR DELETE!
/
		JRST NODEL]
	LOOKUP DSK,LKENT
	JRST [	SKIPGE DET
		PUSHJ P,XERR
		PUSHJ P,ERRPNT
		ASCIZ/LOOKUP FOR DELETE FAILED!
/
		JRST NODEL]
	MOVE A,FILPPN
	MOVEM A,LKENT+3
	SETZM LKENT
	RENAME DSK,LKENT
	CAIA
	JRST NODEL
	SKIPGE DET
	PUSHJ P,XERR
	PUSHJ P,ERRPNT
	ASCIZ/RENAME FOR DELETE FAILED!
/
NODEL:	RELEASE DSK,
	SKIPGE DET
	PUSHJ P,XERR
	PUSHJ P,ERRPNT
	ASCIZ/ALL DONE!
/
	CALLI 12		;LEAVE

NOXGP:	PUSHJ P,DETCHK
	PUSHJ P,XERR
	PUSHJ P,ERRPNT
	ASCIZ /XGP NOT AVAILABLE (I THOUGHT I WAS WAITING FOR IT)!
/
	POPJ P,

XGPPTR:	BLOCK 2

IFN LSTBIT-1,<
XFIX:	MOVE A,[LSTBIT-1]
	MOVE C,LINCNT
	HRRZ D,XGPPTR
XFIXL:	ANDCAM A,LBUFL-1+2(D)
	ADDI D,LBUFL+1
	SOJG C,XFIXL
	POPJ P,
>
CORDWN:	MOVE T,JOBFF
	SUBI T,1
	CALLI T,11
	JRST 4,.
	POPJ P,
FILNAM:	0
FILEXT:	0
	0
FILPPN:	0

LKENT:	BLOCK 4

XGSNAM:	0
XGSEXT:	0
	0
XGSPPN:	0

IBUF:	BLOCK 3

BITTAB:	FOR I←43,0,-1{1⊗I
}
BYTTAB:	FOR I←36,0,-6{REPEAT 6,{77⊗I}}

DBUF:	BLOCK LBUFL+2

PDL:	BLOCK LPDL

END BEG